perm filename GOFAIL.FAI[GO,ALS] blob
sn#105689 filedate 1974-06-12 generic text, type T, neo UTF8
00100 TITLE GOFAIL 5/15/70
00200 ; LAST EDITED BY GJA 72/2/72
00300
00400 EXTERN WHDATA,BLDATA,AREAPT,DRIVER,GDRIVE,CONNDO,GB3
00500 INTERN XGBOAR,XGB1,XGB2,ARMIES,WALLS,AWUPDA,XGRPPT,ZARMY
00600
00700
00800 OPDEF ERRUUO [5B8]
00900 DEFINE SAILERR & (NMBR,MESSAGE) <
01000 ERRUUO 1,[ASCIZ /GOFAIL ERROR NUMBER &NMBR& &MESSAGE/]>
01100
01200
01300
01400 INTERN GBOARD,GB1,GB2,GRPPTR,WHTARM,BLKARM,KWIKAR,KWIKWL,KWIKGR
01500
01600 ;*****CONSTANT SYMBOLS OF LARGE IMPORT
01700 ↓MXARNO←=50 ;MAX NUMBER OF ARMIES (OR WALLS)
01800 ↓BRDWTH←=21 ;BOARD WIDTH, INCLUDING EDGES
01900 ↓ARMCLS←=10 ;# CELLS FOR ARMY (OR WALL) DATA EXTRACTION
02000 ↓WHTOCC←400000 ;WHITE POINT OCCUPANCY
02100 ↓WHTSHF←-=17 ;SHIFTS WHTOCC TO RIGHT END OF WORD
02200 ↓BLKOCC←200000 ;BLACK POINT OCCUPANCY
02300 ↓BNKOCC←100000 ;BLANK POINT OCCUPANCY
02400 ↓NONOCC←40000 ;OFF-EDGE POINT
02500 ↓ARMCNT←100 ;ARMY COUNTER
02600 ↓ARMBTS←77 ;MAXIMUM ALLOWABLE # OF ARMIES
02700 ↓ARMSHF←-6 ;SHIFTS ARMY BITS TO RIGHT END OF WORD
02800 ↓WALCNT←1 ;WALL COUNTER
02900 ↓WALBTS←77 ;MAXIMUM ALLOWABLE # OF WALLS
03000 ↓GRPCNT←200 ;GROUP COUNTER
03100 ↓GRPBTS←177 ;MAXIMUM ALLOWABLE # OF GROUPS
03200 ↓WHTNGH←1 ;WHITE NEIGHBOR COUNTER
03300 ↓BLKNGH←20 ;BLACK NEIGHBOR COUNTER
03400 ↓NGHBTS←17 ;MAXIMUM ALLOWABLE # OF NEIGHBORS
03500 ↓OCCBIT←10 ;POINT OCCUPIED NEIGHBOR BIT
03600 ↓AWSRRH←1 ;STRING LIBERTY COUNTER
03700 ↓AWSRRM←777 ;MAXIMUM ALLOWABLE # OF STR LIBS
03800 ↓AWSLRH←1000 ;STRING STONE COUNTER
03900 ↓AWSLRM←777 ;MAX ALLOWABLE # OF STONES
04000 ↓BCON←100000 ;CONNECTED TO BLACK
04100 ↓WCON←200000 ;CONNECTED TO WHITE
04200 ↓HBCON←40000 ;HALF-CONNECTED TO BLACK
04300 ↓HWCON←20000 ;HALF-CONNECTED TO WHITE
04400 ↓LRHSHF←-11 ;FOR SHIFTING LRH TO RRH
04500 ↓ARMCUT←5 ;ANY ARMY OR WALL WITH LESS INFL IS IGNORED
04600 TACBIT←400000 ;TACTICAL SCOPE MARKER IN GBOARD
04700 STRMAX←=127 ;MAX NUMBER OF STRINGS ALLOWED
04800
04900 ;**********
05000 ; GBOARD IS THE FIRST WORD OF BOARD INFORMATION AT EACH POINT.
05100 ;IT CONTAINS INFLUENCE IN THE LEFT HALF.. GBOARD IS A BRDWTH X BRDWTH
05200 ;ARRAY--THE BORDERS OBVIATE COMPUTATIONAL CHECKS FOR SPECIAL CASES.
05300 ;BITS 23-25 CONTAIN # OF BLACK NEIGHBORS (+1 IF BLACK ON THIS POINT)
05400 ;BITS 26-28 CONTAIN # OF WHITE NEIGHBORS (+1 IF WHITE ON THIS POINT)
05500 ;**********
05600
05700 XGBOAR: GBOARD ;ALSO POINTER FOR SAIL
05800 0
05900 BRDWTH*BRDWTH-1
06000 1
06100 XWD 1,BRDWTH*BRDWTH
06200 GBOARD: BLOCK BRDWTH*BRDWTH
06300
06400 ;**********
06500 ; GB1 IS A BRDWTH X BRDWTH ARRAY HOLDING A SECOND WORD OF INFORMATION
06600 ;ON EACH BOARD POINT. BITS 6-11 CONTAIN ARMY #, BITS 12-17 CONTAIN WALL
06700 ;#, POINT OCCUPATION STATUS (W,B,BLNK,OFFEDGE) IN BITS 19-22, GROUP # IN
06800 ;BITS 23-28, STRING # IN BITS 29-35. ARMY AND WALL INFO MUST BE IN THE
06900 ;LEFT HALF BECAUSE OF AWUPDA PROGRAMMING. ALL RECURSIVE SEARCHES ARE
07000 ;PRESENTLY DONE USING GB1.
07100 ;**********
07200
07300 XGB1: GB1 ;ALSO POINTER FOR SAIL
07400 0
07500 BRDWTH*BRDWTH-1
07600 1
07700 XWD 1,BRDWTH*BRDWTH
07800 GB1: BLOCK BRDWTH*BRDWTH
07900
08000 ;**********
08100 ; GB2 IS A BRDWTH X BRDWTH ARRAY HOLDING THE SCORE OF EACH BOARD
08200 ;POINT FOR EACH SIDE ACCORDING TO ONE OF THE EVALUATION FUNCTIONS.
08300 ;LEFT HALFWORD IS FOR "ENEMY", RIGHTHALF IS FOR "FRIENDLY". THE UNITS
08400 ;BIT IS 0 AFTER A STRATEGIC EVALUATION. IF THE POINT LOOKS "GOOD
08500 ;ENOUGH", A TACTICAL EVALUATION IS MADE AND THE UNITS BIT IS TURNED
08600 ;ON (SO WE WON'T LOOK AT THIS POINT AGAIN). NOTE TACTICAL EVALUATION
08700 ;ONLY IS DONE WRT "FRIENDLY" AT PRESENT.
08800 ;**********
08900
09000 XGB2: GB2 ;ALSO POINTER FOR SAIL
09100 0
09200 BRDWTH*BRDWTH+1
09300 1
09400 XWD 1,BRDWTH*BRDWTH+2
09500 GB2: BLOCK BRDWTH*BRDWTH
09600 377777377777
09700 400000400000
09800
09900 ;**********
10000 ; TEMPORARY STORAGE AVAILABLE TO ANY SUFFICIENTLY INDEPENDENT MAJOR
10100 ;SUBROUTINE IN GOFAIL. AT PRESENT, THIS CORE IS USED FOR LEGAL-UNMOVE
10200 ;AND AWUPDA. THERE ARE ALSO SOME UNIMPORTANT PERMANENT CELLS HERE.
10300 ;**********
10400
10500 ;*****TEMP STORAGE
10600 WHTARM: BLOCK BRDWTH
10700 LASTWH: 0
10800 BLKARM: BLOCK BRDWTH
10900 LASTBL: 0
11000 INSTSV: 0
11100 TACSV1: 0
11200 CHNGGB: 0
11300 AWLCMB: 0
11400
11500 ;**********
11600 ; GROUP DESCRIPTION STORAGE. GROUPS ARE EVALUATED LIKE ARMIES
11700 ;AND WALLS BUT ARE STORED AND SAVED LIKE STRINGS. THE SAME CONVENTIONS
11800 ;WRT #=0 AND #=177 APPLY TO GROUPS. NOTE IT IS ONLY ASSUMED THAT TREATING
11900 ;GROUPS LIKE STRINGS DURING RESTORING IS IN FACT FASTER.
12000 ;**********
12100
12200 XGRPPT: GRPPTR-3 ;POINTER FOR SAIL
12300 GRPPTR
12400 -3
12500 MXARNO*3-1
12600 1
12700 XWD 1,MXARNO*3+3
12800 SMLLGP: 0
12900 0
13000 0
13100 GRPPTR: BLOCK MXARNO*3
13200
13300 ;**********
13400 ; THE ROUTINE ARWLUP PRODUCES PICTURES OF ARMIES AND WALLS IN THE
13500 ;FOLLOWING DATA STRUCTURE. ZARMY(REG) HOLDS TOTAL INFLUENCE IN LEFT HALF
13600 ;AND TOTAL PONTS IN THE RIGHT HALF. ZARMY+MXARNO(REG) HOLDS THE OFFSET
13700 ;ADDRESS OF A BOARD POINT IN THE ARMY. ARMYTH IS THE ARMY THRESHHOLD,
13800 ;AND ARMYTM IS ITS NEGATIVE. SMLLAR IS SMALL ARMY THRESHHOLD.
13900 ;WALLS ARE "JUST LIKE ARMIES".
14000 ;**********
14100
14200 ;*****ARMY CALCULATION STORAGE
14300 ARMIES: ZARMY-3 ;POINTER FOR SAIL
14400 ZARMY
14500 -3
14600 2*MXARNO-1
14700 1
14800 XWD 1,2*MXARNO+3
14900 SMLLAR: 0
15000 ARMYTH: 0
15100 ARMYTM: 0
15200 ZARMY: BLOCK 2*MXARNO
15300
15400 ;*****WALL CALCULATION STORAGE
15500 WALLS: ZWALL-3 ;POINTER FOR SAIL
15600 ZWALL
15700 -3
15800 2*MXARNO-1
15900 1
16000 XWD 1,2*MXARNO+3
16100 SMLLWL: 0
16200 WALLTH: 0
16300 WALLTM: 0
16400 ZWALL: BLOCK 2*MXARNO
00100 BEGIN ARWLUP
00200
00300 ;**********
00400 ; THE PURPOSE OF ENTRY ARWLUP IS TO UPDATE THE WHOLE BOARD WITH
00500 ;RESPECT TO ARMIES, WALLS AND SOME OTHER MORE DETAILED INFORMATION.
00600 ;IT IS EXPECTED THAT THIS BLOCK WILL BE USED AT THE END OF A PLY, AS
00700 ;IT IS RATHER SLOW. IT MAY, HOWEVER, BE CALLED AT ANY TIME.
00800 ; ENTRY QKLOOK IS A QUICK-AND-DIRTY JOB OF ESTIMATING WHAT THE LAST
00900 ;MOVE DID IN TERMS OF A LOCAL (SAY 11X11) AREA. NOTE THAT THIS SUBROUTINE
01000 ;WILL GET APPROXIMATE ANSWERS FOR ARMY, WALL, GROUP DATA WITHOUT CHANGING
01100 ;QUANTITIES IN GB1.
01200 ;**********
01300
01400 ;*****REGISTERS USED AND THEIR SYMBOLICS
01500 CURINF←0 ;HOLDS CURRENT POINT INFL IN BITS 0-17
01600 TAC←1 ;ADDRESSES GBOARD AND GB1
01700 TAC1←2
01800 TAC2←3
01900 TAC3←4
02000 TAC4←5 ;INDIRECT ADDRESS FOR GBOARD
02100 TAC5←6 ;INDIRECT ADDRESS FOR GB1
02200 WBREG←7 ;OPPOSITE OF BWREG
02300 CURAWL←10 ;HOLDS CURRENT ARMY NUMBER (AND ADDRESS)
02400 DATBAS←11 ;HOLDS POINTER TO ARMIES OR WALLS
02500 BWREG←12 ;TELLS WHETHER TO USE BLACK OR WHITE
02600 OTRAWL←13 ;SECONDARY ARMY NUMBER...USED AS SEARCH IN DRIVER
02700 REPLCE←14 ;AS IN DRIVER
02800 CLEAR←15 ;AS IN DRIVER
02900 PDP←17
03000
03100 ;**********
03200 ; SETUP ROUTINE FOR TEMPORARY STORAGE CLEARING AND FOR PERM
03300 ;STORAGE CHAINING. NOTE TAC,DATBAS,WBREG MUST BE PRESET.
03400 ;**********
03500 AWGSET: HRRZ BWREG,DATBAS ;DATBAS POINTS TO START OF PERM STORAGE
03600 AOS WBREG ;WBREG IS COUNTER FOR NAME, ADDRESS
03700 ADD BWREG,WBREG ;BWREG USED TO LINK STORAGE
03800 SETZM MXARNO-1(BWREG)
03900 MOVEM BWREG,-1(BWREG)
04000 SOJGE TAC,.-3
04100 SETZM 0(BWREG) ;END-OF-LINKED-STORAGE WARNING
04200 SETZM MXARNO(BWREG)
04300 MOVEI TAC,2*BRDWTH+1
04400 SETZM WHTARM(TAC)
04500 SOJGE TAC,.-1 ;TEMP STORAGE IS CLEARED
04600 POPJ PDP,
04700
04800 ;**********
04900 ; BRDLP1 IS THE WHOLE INNER LOOP FOR QUICK EVALUATION OF ARMIES, WALLS,
05000 ;OR GROUPS. THERE ARE 2 IMPORTANT SWITCHES USED IN COMBINATION OF ENTITIES:
05100 ;1. CHNGGB.....IF ZERO THEN GB1 IS NEVER UPDATED (EXCEPT BY NEIADJ)
05200 ;2. AWLCMB.....IF ZERO THEN COMBINE GROUPS, ELSE COMBINE ARMIES OR WALLS
05300 ;NOTE THAT THE MAIN JOB OF THIS WHOLE ROUTINE IS TO DECIDE WHAT ENTITY
05400 ;THE CURRENT BOARD POINT BELONGS TO.
05500 ;**********
05600 BORDLP: MOVEI TAC,BRDWTH-3
05700 SETZM LASTWH ;NO PREVIOUS POINT AT START OF LINE
05800 SETZM LASTBL
05900 BRDLP1: SKIPE CHNGGB
06000 ANDCAM CLEAR,@TAC5 ;ERASE THE NAME IN GB1
06100 HLL CURINF,@TAC4 ;INFLUENCE AT CURRENT BOARD POINT
06200 CAML CURINF,-2(DATBAS) ;ARMYTH OR WALLTH TEST
06300 JRST BLAKPT
06400 CAMLE CURINF,-1(DATBAS) ;ARMYTH OR WALLTM TEST
06500 JRST ZERPRC
06600 SKIPA BWREG,[XWD TAC,WHTARM] ;SET WHITE TO FRIENDLY
06700 BLAKPT: SKIPA BWREG,[XWD TAC,BLKARM] ;SET BLACK TO FRIENDLY
06800 SKIPA WBREG,[XWD TAC,BLKARM]
06900 MOVE WBREG,[XWD TAC,WHTARM]
07000 BTHCHG: MOVE CURAWL,@BWREG ;WAS LAST ROW FRIENDLY
07100 SETZM @WBREG ;GET RID OF POSSIBLE ENEMY TRACE
07200 JUMPE CURAWL,ARMLST ;NO IT WASNT FRIENDLY
07300 SKIPN OTRAWL,BRDWTH(BWREG) ;THIS IS THE LAST POINT PROCESSED
07400 JRST ARMYOK-1 ;LAST POINT WASNT FRIENDLY
07500 CAMN CURAWL,OTRAWL
07600 JRST ARMYOK-1
07700 ;*****COMBINE TWO FRIENDLY ARMIES
07800 MOVEM TAC,TACSV1 ;KEEP TRACK OF WHERE WE ARE
07900 MOVM TAC,0(CURAWL)
08000 MOVM REPLCE,0(OTRAWL)
08100 CAMGE TAC,REPLCE ;MAKE SURE THE SMALLER ARMY IS ERASED
08200 EXCH CURAWL,OTRAWL
08300 MOVE REPLCE,0(DATBAS) ;GET NEXT FREE STRING
08400 EXCH REPLCE,0(OTRAWL) ;RELEASE WORD #1 OF OTRAWL
08500 ADDM REPLCE,0(CURAWL) ;COMBINE INFLUENCE AND POINT NUMBERS
08600 MOVEM OTRAWL,0(DATBAS) ;SAVE PTR TO NEXT STRING
08700 MOVEI TAC,BRDWTH
08800 CAMN OTRAWL,@BWREG
08900 MOVEM CURAWL,@BWREG
09000 SOJGE TAC,.-2 ;NOW THE CURRENT TRACES OF OTRAWL ARE GONE
09100 ;**********SPECIAL 3RD WORD PROCESSING FOR GROUPS
09200 SKIPE AWLCMB
09300 JRST AWLCNT
09400 SETZ TAC,
09500 EXCH TAC,2*MXARNO(OTRAWL)
09600 ADDM TAC,2*MXARNO(CURAWL)
09700 AWLCNT: SETZ TAC,
09800 EXCH TAC,MXARNO(OTRAWL) ;RELEASE WORD #2 OF OTRAWL, SET TAC
09900 HLLZ REPLCE,TAC
10000 ADDM REPLCE,MXARNO(CURAWL) ;ADD IN OFFEDGE INFL
10100 SKIPN CHNGGB ;DO WE CHANGE GB1
10200 JRST DONSET
10300 HRRZ TAC,TAC ;SET INDIR POINTER FOR DRIVER
10400 SKIPN AWLCMB ;ARMY OR WALL (VS GROUP) COMBINATION
10500 JRST GRPCMB
10600 HLLZ OTRAWL,OTRAWL ;OTRAWL IS THE SEARCH USED BY DRIVER
10700 HLLZ REPLCE,CURAWL
10800 PUSHJ PDP,DRIVER ;ERASES TRACES OF OTRAWL IN GB1
10900 JRST DONSET
11000 GRPCMB: HLRZ OTRAWL,OTRAWL ;CHANGE GROUP IN GB1
11100 HLRZ REPLCE,CURAWL
11200 MOVE TAC1,GB1(TAC)
11300 AND TAC1,CLEAR
11400 CAME TAC1,CLEAR
11500 JRST DONSET-1
11600 PUSHJ PDP,CONNDO ;IN CASE GROUP STARTS ON HAFCON
11700 JRST DONSET
11800 PUSHJ PDP,GDRIVE ;NORMAL CASE
11900 DONSET: MOVE TAC,TACSV1
12000 JRST ARMYOK-1
12100 ;*****END ARMY COMBINATION PROCESS
12200 ARMLST: SKIPE CURAWL,BRDWTH(BWREG)
12300 JRST ARMYOK-1 ;LAST POINT WAS FRIENDLY
12400 ;*****NEW ARMY PROCESS
12500 SKIPN CURAWL,0(DATBAS)
12600 SAILERR <1> ;NO MORE NEW ARMY SPACES
12700 ;**** ERROR MESSAGE 1 ****
12800 MOVEI OTRAWL,@TAC4 ;SET BASE POINTER
12900 SUBI OTRAWL,GBOARD
13000 MOVEM OTRAWL,MXARNO(CURAWL)
13100 SETZ OTRAWL,
13200 EXCH OTRAWL,0(CURAWL) ;ZERO OUT NEW WORD #1
13300 MOVEM OTRAWL,0(DATBAS) ;SAVE POINTER TO NEXT FREE ARMY
13400 ;*****END NEW ARMY PROCESS
13500 SETZM BRDWTH(WBREG) ;ZERO OUT POSSIBLE ENEMY ARMY TRACE
13600 ARMYOK: MOVEM CURAWL,BRDWTH(BWREG) ;SAVE TO COMPARE WITH NEXT POINT
13700 MOVEM CURAWL,@BWREG ;SAVE FOR NEXT ROW
13800 ADDM CURINF,0(CURAWL) ;ADD INFLUENCE AND (PRESET) RHS
13900 NDAR11: CAIN TAC,BRDWTH-3 ;THIS INSTR GETS CHANGED
14000 AOJA TAC,NDAR12
14100 JUMPN TAC,NDARLP
14200 HLLZ OTRAWL,-1(TAC4)
14300 NDAR13: JUMPG CURINF,.+4 ;THIS LAST PIECE OF CODE TAKES
14400 CAMLE OTRAWL,-1(DATBAS) ;CARE OF EDGE POINT COUNT AND
14500 JRST NDARLP ;EDGE INFLUENCE TOTAL
14600 JRST .+3
14700 CAMGE OTRAWL,-2(DATBAS)
14800 JRST NDARLP
14900 ADDM OTRAWL,MXARNO(CURAWL)
15000 MOVEI OTRAWL,AWSLRH
15100 ADDM OTRAWL,0(CURAWL)
15200 NDARLP: SKIPN CHNGGB
15300 JRST NDARL1
15400 AND CURAWL,CLEAR
15500 ORM CURAWL,@TAC5 ;NAME GB1 POINT
15600 NDARL1: SOJGE TAC,BRDLP1
15700 POPJ PDP,
15800 NDAR12: HLLZ OTRAWL,@TAC4
15900 SOJA TAC,NDAR13
16000
16100 ;*****TAKE CARE OF THE CASE WHERE NO ENTITY AT POINT
16200 ZERPRC: SETZM LASTWH
16300 SETZM LASTBL
16400 SETZM WHTARM(TAC)
16500 SETZM BLKARM(TAC)
16600 SETZ CURAWL,
16700 SOJGE TAC,BRDLP1 ;THIS INSTR GETS CHANGED
16800 POPJ PDP,
16900 ;*****TAKE CARE OF ENDING BRDLP1 (GRPLP1) FOR GROUPS
17000 NDGRL1: TRNN CURINF,AWSLRH
17100 JRST NDGRLP
17200 MOVEI CURINF,@TAC4
17300 SUBI CURINF,GBOARD
17400 HRRM CURINF,MXARNO(CURAWL) ;GROUP MUST START ON STONE
17500 NDGRLP: SKIPN CHNGGB
17600 JRST NDGRPP
17700 MOVS CURAWL,CURAWL
17800 AND CURAWL,CLEAR
17900 ORM CURAWL,@TAC5 ;NAME GB1 POINT
18000 NDGRPP: SOJGE TAC,GRPLP1 ;THIS INSTR GETS CHANGED
18100 POPJ PDP,
18200
18300 ;**********SPECIAL TESTING FOR GROUP FINDING
18400 GRPLOP: MOVEI TAC,BRDWTH-3
18500 SETZM LASTWH
18600 SETZM LASTBL
18700 GRPLP1: SKIPE CHNGGB
18800 ANDCAM CLEAR,@TAC5 ;ERASE THE NAME IN GB1
18900 MOVE CURINF,[XWD 777777,BCON+WCON+HBCON+HWCON+OCCBIT*(BLKNGH+WHTNGH)]
19000 AND CURINF,@TAC4
19100 TRNN CURINF,BCON+WCON
19200 JRST HAFPRC
19300 TRZN CURINF,OCCBIT*(BLKNGH+WHTNGH)
19400 JRST .+3
19500 ANDI CURINF,BCON+WCON
19600 TROA CURINF,AWSLRH ;POINT OCCUPIED
19700 TRO CURINF,AWSRRH ;POINT BLANK
19800 TRZN CURINF,BCON
19900 TRZA CURINF,WCON
20000 JRST BLAKPT
20100 JRST BLAKPT-1
20200 HAFPRC: TRNN CURINF,HBCON+HWCON
20300 JRST ZERPRC
20400 JUMP ;THIS INSTR GETS CHANGED
20500 ANDI CURINF,HBCON+HWCON
20600 CAIN CURINF,HBCON+HWCON
20700 JRST BTHPRC
20800 MOVE BWREG,[JRST HAFPR2]
20900 EXCH BWREG,ARMYOK+2
21000 MOVEM BWREG,INSTSV
21100 TRZN CURINF,HBCON
21200 TRZA CURINF,HWCON
21300 SKIPA BWREG,[XWD TAC,BLKARM]
21400 SKIPA BWREG,[XWD TAC,WHTARM]
21500 JRST BLAKPT+1
21600 JRST BLAKPT+2
21700 BTHPRC: TRZ CURINF,HBCON+HWCON
21800 MOVE BWREG,[JRST HAFPR1]
21900 EXCH BWREG,ARMYOK+2
22000 MOVEM BWREG,INSTSV
22100 MOVE BWREG,[SKIPA CURAWL,@BWREG] ;DONT ZERO @WBREG
22200 MOVEM BWREG,BTHCHG
22300 MOVE BWREG,[XWD TAC,BLKARM]
22400 JRST BLAKPT+1
22500 HAFPR1: HRLZI BWREG,AWSRRH
22600 ADDM BWREG,MXARNO(CURAWL)
22700 MOVE TAC1,@TAC4
22800 TRNE TAC1,2000
22900 ADDM BWREG,2*MXARNO(CURAWL) ;COUNT DEAD MAN AS HALFEYE
23000 MOVE BWREG,[JRST HAFPR2-2]
23100 MOVEM BWREG,ARMYOK+2
23200 MOVE BWREG,[XWD TAC,WHTARM]
23300 JRST BLAKPT+2
23400 MOVE BWREG,[MOVE CURAWL,@BWREG]
23500 MOVEM BWREG,BTHCHG
23600 HAFPR2: HRLZI BWREG,AWSRRH
23700 ADDM BWREG,MXARNO(CURAWL)
23800 MOVE TAC1,@TAC4
23900 TRNE TAC1,2000
24000 ADDM BWREG,2*MXARNO(CURAWL) ;COUNT DEAD MAN AS HALFEYE
24100 MOVE BWREG,INSTSV
24200 MOVEM BWREG,ARMYOK+2
24300 JRST NDGRPP
24400
24500 ;**********
24600 ; THIS CODE DOES A PRELIMINARY EXTRACTION OF ARMY-WALL-GROUP DATA
24700 ;FOR DIRECT USE IN BOARD EVALUATION. NOTE BWREG AND WBREG MUST BE PRESET.
24800 ;**********
24900 FINPRC: ADD BWREG,BLDATA
25000 ADD WBREG,WHDATA
25100 MOVEI TAC,ARMCLS-1 ;CLEAR STORAGE
25200 SETZM @BWREG
25300 SETZM @WBREG
25400 SOJGE TAC,.-2
25500 MOVEI TAC,MXARNO-1 ;START WITH LAST POSSIBLE ARMY
25600 MOVE OTRAWL,DATBAS
25700 ADDI OTRAWL,MXARNO ;INDIR ADDR FOR ARMY WORD #2
25800 NXTLOP: SKIPN TAC1,@OTRAWL
25900 JRST NXTAWL ;NO ARMY IN THIS SLOT
26000 HLRE TAC3,TAC1
26100 MOVM TAC3,TAC3
26200 SKIPL TAC4,@DATBAS
26300 SKIPA CURAWL,BWREG ;IT'S A BLACK ARMY
26400 MOVE CURAWL,WBREG ;IT'S A WHITE ARMY
26500 HRRZ TAC5,TAC4 ;# POINTS IN TAC5
26600 HLRE TAC4,TAC4 ;ARMY TOT INFLUENCE IN TAC4
26700 MOVM TAC4,TAC4 ;MAKE INFLUENCE POSITIVE
26800 SKIPN AWLCMB
26900 JRST .+3 ;NO GROUP IS TOO SMALL TO CONSIDER
27000 CAIGE TAC4,ARMCUT ;IS THE ENTITY TOO SMALL TO CONSIDER
27100 JRST NXTAWL
27200 MOVEI TAC2,AWSLRM*AWSLRH
27300 AND TAC2,TAC5
27400 LSH TAC2,LRHSHF ;THIS IS THE LRH QUANTITY
27500 ANDI TAC5,AWSRRM
27600 SUB TAC5,-3(DATBAS) ;THIS IS THE # POINTS
27700 ADDM TAC3,3(CURAWL) ;TOTAL OFFEDGE INFLUENCE
27800 ADDM TAC2,4(CURAWL) ;# OF OFFEDGE POINTS
27900 AOS 2(CURAWL) ;# ARMIES
28000 ADDM TAC5,1(CURAWL) ;TOTAL # POINTS
28100 ADDM TAC4,0(CURAWL) ;INFLUENCE TOTAL
28200 JUMPGE TAC5,NXTAWL ;NOT A SMALL ENTITY
28300 ADDM TAC3,10(CURAWL)
28400 ADDM TAC2,11(CURAWL)
28500 AOS 7(CURAWL) ;# SMALL ARMIES
28600 ADDM TAC5,6(CURAWL) ;TOTAL # SMALL POINTS
28700 ADDM TAC4,5(CURAWL) ;SMALL INFLUENCE TOTAL
28800 NXTAWL: SOJGE TAC,NXTLOP
28900 POPJ PDP,
29000
29100 ;**********
29200 ; THIS CODE IS CALLED WHEN AN EDGE POINT IS ENCOUNTERED DURING
29300 ;PROCESSING AN ARMY OR A WALL. ACTUALLY, THIS PARTICULAR ROUTINE WILL
29400 ;TAKE CARE OF EDGE POINTS ALONG THE TOP AND BOTTOM EDGES OF THE
29500 ;BOARD.....SIDE EDGE POINTS ARE "BUILT INTO" BRDLP1
29600 ;**********
29700 ADDI TAC4,BRDWTH ;TO POSITION TAC4 FOR THE BOTTOM
29800 EDGHDL: SKIPE CURAWL,BLKARM(TAC)
29900 JRST BLKEDG
30000 SKIPN CURAWL,WHTARM(TAC)
30100 JRST NXTEDG
30200 HLLZ OTRAWL,@TAC4
30300 CAMLE OTRAWL,-1(DATBAS)
30400 JRST NXTEDG
30500 JRST .+4
30600 BLKEDG: HLLZ OTRAWL,@TAC4
30700 CAMGE OTRAWL,-2(DATBAS)
30800 JRST NXTEDG
30900 ADDM OTRAWL,MXARNO(CURAWL)
31000 MOVEI OTRAWL,AWSLRH
31100 ADDM OTRAWL,0(CURAWL)
31200 NXTEDG: SOJGE TAC,EDGHDL
31300 SUBI TAC4,BRDWTH
31400 POPJ PDP,
00100 ;**********
00200 ; THIS CODE DIRECTS THE UPDATING FOR ARMIES AND WALLS. IT
00300 ;HANDLES UPDATING GB1 (WITH ARMY AND WALL NAMES) OR SIMPLY
00400 ;CALCULATING ARMIES OR WALLS WITHOUT CHANGING GB1.
00500 ;**********
00600 AWLDO: MOVE TAC4,[SOJGE TAC,BRDLP1]
00700 MOVEM TAC4,ZERPRC+5
00800 MOVE TAC4,[CAIN TAC,BRDWTH-3]
00900 MOVEM TAC4,NDAR11
01000 MOVE TAC4,[XWD TAC,GBOARD+BRDWTH*(BRDWTH-2)+1]
01100 SKIPE CHNGGB
01200 MOVE TAC5,[XWD TAC,GB1+BRDWTH*(BRDWTH-2)+1]
01300 AWLDO1: PUSHJ PDP,BORDLP
01400 CAME TAC4,[XWD TAC,GBOARD+BRDWTH*(BRDWTH-2)+1]
01500 JRST .+3
01600 MOVEI TAC,BRDWTH-3
01700 PUSHJ PDP,EDGHDL-1
01800 SUBI TAC4,BRDWTH
01900 SKIPE CHNGGB
02000 SUBI TAC5,BRDWTH
02100 CAML TAC4,[XWD TAC,GBOARD+BRDWTH+1]
02200 JRST AWLDO1
02300 MOVEI TAC,BRDWTH-3
02400 JRST EDGHDL
02500
02600 ;**********
02700 ;ARMYDO SETS UP AND CALCULATES ARMY DATA
02800 ;**********
02900 ↑KWIKAR:SETZM CHNGGB ;DISABLE GB1 CHANGING
03000 SETOM AWLCMB ;SIGNAL ARMY-WALL PROCESSING
03100 ARMYDO: HRLZI WBREG,ARMCNT
03200 MOVE DATBAS,[XWD TAC,ZARMY]
03300 MOVEI TAC,MXARNO-2
03400 PUSHJ PDP,AWGSET
03500 MOVEI CURINF,1
03600 PUSHJ PDP,AWLDO
03700 HRLZI BWREG,TAC
03800 HRLZI WBREG,TAC
03900 JRST FINPRC
04000
04100 ;**********
04200 ;WALLDO SETS UP AND CALCULATES WALL DATA
04300 ;**********
04400 ↑KWIKWL:SETZM CHNGGB ;DISABLE GB1 CHANGING
04500 SETOM AWLCMB ;SIGNAL ARMY-WALL PROCESSING
04600 WALLDO: HRLZI WBREG,WALCNT
04700 MOVE DATBAS,[XWD TAC,ZWALL]
04800 MOVEI TAC,MXARNO-2
04900 PUSHJ PDP,AWGSET
05000 MOVEI CURINF,1
05100 PUSHJ PDP,AWLDO
05200 MOVE BWREG,[XWD TAC,ARMCLS]
05300 MOVE WBREG,BWREG
05400 JRST FINPRC
05500
05600 ;**********
05700 ;GRUPDO SETS UP AND CALCULATES GROUP DATA. MOST OF THE SAME CODE AS
05800 ;FOR ARMIES AND WALLS IS USED. NOTE THE RATHER RARE CASE OF A POINT
05900 ;HALF-CONNECTED TO BOTH SIDES IS ESPECIALLY MESSY TO HANDLE.
06000 ;***********
06100 ↑KWIKGR:SETZM AWLCMB ;SIGNAL GROUP PROCESSING
06200 SETZM CHNGGB ;DISABLE GB1 CHANGING
06300 GRUPDO: HRLZI WBREG,GRPCNT
06400 MOVE DATBAS,[XWD TAC,GRPPTR]
06500 MOVEI TAC,MXARNO-1
06600 SETZM GRPPTR+2*MXARNO(TAC)
06700 SOJGE TAC,.-1
06800 MOVEI TAC,MXARNO-2
06900 PUSHJ PDP,AWGSET
07000 MOVE TAC4,[SOJGE TAC,GRPLP1]
07100 MOVEM TAC4,ZERPRC+5
07200 MOVE TAC4,[JRST NDGRL1]
07300 MOVEM TAC4,NDAR11
07400 MOVE TAC4,[XWD TAC,GBOARD+BRDWTH*(BRDWTH-2)+1]
07500 SKIPE CHNGGB
07600 MOVE TAC5,[XWD TAC,GB1+BRDWTH*(BRDWTH-2)+1]
07700 GRPDO1: PUSHJ PDP,GRPLOP
07800 CAMG TAC4,[XWD TAC,GBOARD+BRDWTH+1]
07900 JRST GRPDO2
08000 SUBI TAC4,BRDWTH
08100 SKIPE CHNGGB
08200 SUBI TAC5,BRDWTH
08300 JRST GRPDO1
08400 GRPDO2: MOVE BWREG,[XWD TAC,2*ARMCLS]
08500 MOVE WBREG,BWREG
08600 PUSHJ PDP,FINPRC
08700 SUBI BWREG,2*ARMCLS
08800 SUBI WBREG,2*ARMCLS
08900 POPJ PDP,
09000
09100 ;**********
09200 ; THOROUGH ARMY-WALL-GROUP SCAN DONE AFTER A MOVE IS
09300 ;ACTUALLY PUT ON THE BOARD.
09400 ;**********
09500 ↑AWUPDA:MOVE TAC2,[770000740177]
09600 MOVEI TAC,BRDWTH*(BRDWTH-2)-1
09700 ANDM TAC2,GB1+BRDWTH(TAC)
09800 SOJGE TAC,.-1 ;CLEAR OLD AWG NUMBERS
09900 SETOM CHNGGB ;ENABLE GB1 CHANGING
10000 SETOM AWLCMB ;SET FOR ARMY-WALL COMBINING IN GB1
10100 HRLZI CLEAR,ARMCNT*ARMBTS
10200 PUSHJ PDP,ARMYDO
10300 HRLZI CLEAR,WALCNT*WALBTS
10400 PUSHJ PDP,WALLDO
10500 SETZM AWLCMB ;SET FOR GROUP COMBINING IN GB1
10600 MOVE TAC4,[ORM CLEAR,@TAC5] ;ENABLE GROUP GB1 CHANGE
10700 MOVEM TAC4,HAFPRC+2
10800 MOVEI CLEAR,GRPCNT*GRPBTS
10900 PUSHJ PDP,GRUPDO
11000 MOVE TAC4,[JUMP] ;DISABLE GROUP GB1 CHANGE
11100 MOVEM TAC4,HAFPRC+2
11200 POPJ PDP,
11300
11400 BEND
00100 BEGIN UTILS
00200
00300 INTERN SCRUPD,GBFGET,GBEGET,GBFPUT,GBEPUT,INFLPT
00400 INTERN SCOSET,REDOST
00500 EXTERN SCRENV,SCRFRV,GAMVAL,STRPTR,PFORCE
00600
00700 ;**********
00800 ;ALMOST ALL THE UTILITY ROUTINES IN THIS BLOCK HAVE A DIRECT CONNECTION
00900 ;WITH THE EVALUATION PART OF THE GO PLAYER. THE LANGUAGE IS FAIL
01000 ;BECAUSE OF THE USE OF HALFWORDS, THE NEED FOR SPEED, OR BOTH. SAVER PUTS
01100 ;A READY-TO-GO CORE IMAGE ON THE DISK, SAVING ABOUT 20-30 SECONDS
01200 ;OF EVALUATION STARTUP TIME.
01300 ;**********
01400
01500 TAC←1
01600 TAC1←2
01700 TAC2←3
01800 TAC3←4
01900 TAC4←5
02000 TAC5←6
02100 TAC6←7
02200 PDP←17
02300
02400 ;**********FIND POINTERS SCRFRV AND SCRENV TO INDICATE THE 15 BEST
02500 ;**********MOVES FOR EACH SIDE. NOTE THIS ROUTINE FINDS ONLY THE
02600 ;**********BEST SCORES WITH RESPECT TO GB2.
02700 SCRUPD: MOVE TAC1,SCRENV
02800 HRRM TAC1,ENMYSC
02900 MOVEI TAC1,1(TAC1)
03000 HRRM TAC1,ENMYS1
03100 MOVE TAC1,SCRFRV
03200 HRRM TAC1,FRNDSC
03300 MOVEI TAC1,1(TAC1)
03400 HRRM TAC1,FRNDS1
03500 MOVEI TAC1,BRDWTH*(BRDWTH-1)-2
03600 MOVEI TAC2,BRDWTH*BRDWTH+1
03700 MOVEI TAC,=15
03800 ENMYSC: MOVEM TAC2,0(TAC)
03900 FRNDSC: MOVEM TAC2,0(TAC)
04000 SOJG TAC,.-2
04100 MOVEI TAC5,BRDWTH-3
04200 SCRLOP: MOVEI TAC4,1
04300 MOVEI TAC,=15
04400 XCT LOADT2(TAC4)
04500 MOVE TAC3,@ENMYSC(TAC4)
04600 XCT LOADT3(TAC4)
04700 CAMG TAC2,TAC3
04800 JRST SCREND
04900 SOJLE TAC,.+6
05000 MOVE TAC3,@ENMYSC(TAC4)
05100 MOVEM TAC3,@ENMYS1(TAC4)
05200 XCT LOADT3(TAC4)
05300 CAMLE TAC2,TAC3
05400 JRST .-5
05500 MOVEM TAC1,@ENMYS1(TAC4)
05600 SCREND: SOJGE TAC4,SCRLOP+1
05700 SOJ TAC1,
05800 SOJGE TAC5,SCRLOP
05900 CAIGE TAC1,BRDWTH+1
06000 POPJ PDP,
06100 SUBI TAC1,2
06200 JRST SCRLOP-1
06300 LOADT2: HLRE TAC2,GB2(TAC1)
06400 HRRE TAC2,GB2(TAC1)
06500 LOADT3: HLRE TAC3,GB2(TAC3)
06600 HRRE TAC3,GB2(TAC3)
06700 ENMYS1: XWD TAC,0
06800 FRNDS1: XWD TAC,0
06900
07000 ;**********VAL←GBFGET(INDEX)
07100 GBFGET: MOVE TAC,-1(PDP)
07200 HRRE 1,GB2(TAC)
07300 SUB PDP,[XWD 2,2]
07400 JRST @2(PDP)
07500 ;**********VAL←GBEGET(INDEX)
07600 GBEGET: MOVE TAC,-1(PDP)
07700 HLRE 1,GB2(TAC)
07800 JRST GBFGET+2
07900 ;**********GBFPUT(VALUE,INDEX)
08000 GBFPUT: MOVE TAC,-1(PDP)
08100 MOVE TAC1,-2(PDP)
08200 HRRM TAC1,GB2(TAC)
08300 SUB PDP,[XWD 3,3]
08400 JRST @3(PDP)
08500 ;**********GBEPUT(VALUE,INDEX)
08600 GBEPUT: MOVE TAC,-1(PDP)
08700 MOVE TAC1,-2(PDP)
08800 HRLM TAC1,GB2(TAC)
08900 JRST GBFPUT+3
09000 ;**********VAL←INFLPT(INDEX)
09100 INFLPT: MOVE TAC,-1(PDP)
09200 HLRE 1,GBOARD(TAC)
09300 JRST GBFGET+2
09400
09500 ;**********
09600 ; FIND BOARD POINTS ACCESSED BY THE TACTICAL ANALYSIS
09700 ;JUST COMPLETED AND MAKE THE CORRESPONDING BIT LOCATIONS IN THE
09800 ;SECOND WORD OF THE STRING DESCRIPTOR SHOW WHICH REGIONS OF THE
09900 ;BOARD ARE USED IN THE ANALYSIS.
10000 ;**********
10100 SCOSET: MOVE TAC4,PFORCE
10200 MOVE TAC4,GB1(TAC4)
10300 ANDI TAC4,177 ;STRING NAME
10400 HRLZI TAC,777400
10500 ANDM TAC,STRPTR+STRMAX+1(TAC4) ;ZERO OLD DATA
10600 MOVEI TAC,=16*(BRDWTH+1)
10700 HRLZI TAC5,100 ;BIGGEST BOX BIT
10800 MOVEI TAC6,TACBIT
10900 SCOSE1: MOVEI TAC3,4
11000 MOVEI TAC2,3*BRDWTH(TAC)
11100 SCOSE2: MOVEI TAC1,3(TAC2)
11200 TDNN TAC6,GBOARD(TAC1)
11300 JRST .+3
11400 ANDCAM TAC6,GBOARD(TAC1) ;CLEAR ACCESSED BIT
11500 ORM TAC5,STRPTR+STRMAX+1(TAC4) ;MARK BOX USED
11600 CAMLE TAC1,TAC2
11700 SOJA TAC1,SCOSE2+1 ;FINISHED POINT
11800 SUBI TAC2,BRDWTH ;FINISHED BOX ROW
11900 CAML TAC2,TAC
12000 JRST SCOSE2
12100 LSH TAC5,-1 ;FINISHED BLOCK
12200 JUMPE TAC5,SCOSE3 ;FINISHED WHOLE BOARD
12300 SUBI TAC,4
12400 SOJGE TAC3,SCOSE1+1
12500 SUBI TAC,3*BRDWTH+1 ;FINISHED BOARD ROW
12600 JRST SCOSE1
12700 SCOSE3: POPJ PDP,
12800
12900 ;**********
13000 ; DISCOVER ALL STRINGS POSSIBLY AFFECTED BY A MOVE AT (I,J).
13100 ;MARK THESE STRINGS FOR RE-PROCESSING BY THE TACTICAL ANALYZER.
13200 ;ALSO MARK THE CURRENT STRING (WHICH MIGHT NOT HAVE BEEN ASSIGNED
13300 ;A SCOPE YET).
13400 ;**********
13500 REDOST: MOVE TAC,-2(PDP) ;I-COORD
13600 LSH TAC,-2
13700 IMULI TAC,5
13800 MOVE TAC1,-1(PDP) ;J-COORD
13900 LSH TAC1,-2
14000 ADD TAC,TAC1
14100 MOVEI TAC1,1
14200 LSH TAC1,0(TAC) ;MOVE BOX BIT
14300 HRLZI TAC2,200 ;REPROCESSING BIT
14400 MOVEI TAC3,STRMAX-1
14500 HRRO TAC4,0
14600 TLNN TAC4,STRPTR(TAC3)
14700 JRST .+3 ;NO STRING IN THIS SLOT
14800 TDNE TAC1,STRPTR+STRMAX+1(TAC3)
14900 ORM TAC2,STRPTR+STRMAX+1(TAC3) ;REPROCESS THIS STRING
15000 SOJG TAC3,.-4
15100 MOVE TAC,-2(PDP)
15200 IMULI TAC,BRDWTH
15300 ADD TAC,-1(PDP)
15400 MOVE TAC3,GB1(TAC)
15500 ANDI TAC3,177
15600 ORM TAC2,STRPTR+STRMAX+1(TAC3) ;MARK CURRENT STRING
15700 SUB PDP,[XWD 3,3]
15800 JRST @3(PDP)
15900
16000 BEND
16100
16200 END